home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / epistat.arc / RANKTEST.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-08-18  |  8.3 KB  |  180 lines
  1. 1   REM         SIGNED RANK, RANK SUM AND RANK CORRELATION TESTS
  2. 2  REM             Written by Tracy L. Gustafson, M.D.
  3. 3  REM            Round Rock, Texas. Version 2.0, 1983
  4. 5  DEF SEG=&H40
  5. 6  A=PEEK(&H17): IF NOT(A AND &H20) THEN POKE &H17,(A AND (NOT &H20)) OR &H20
  6. 10  DEF SEG: KEY OFF: SCREEN 0,0: WIDTH 80: COLOR 7,0,1
  7. 15  CLEAR ,,1024: DEFINT A-C,N,T,Z: DEFSTR D
  8. 20  CLS: PRINT TAB(19);"KEY";STRING$(35,205);"CLOSE"
  9. 22  PRINT TAB(19);"OPEN RANK TESTS (Non-parametric tests) OPEN"
  10. 25  PRINT TAB(19);"SCREEN";STRING$(35,205);"LOAD"
  11. 30  PRINT: PRINT: AP=CSRLIN: PRINT TAB(10);: ON ERROR GOTO 1110
  12. 40  PRINT "What is the name of the DATAFILE you wish to analyze?"
  13. 41  PRINT TAB(13);"(If you have already calculated rank sums,": PRINT TAB(15);"press ENTER to skip directly to RANK TESTS.)"
  14. 42  LOCATE AP,66: INPUT "",FILE$
  15. 43  IF FILE$="" THEN DIM C(100),CF(100): PRINT: GOTO 110
  16. 50  OPEN FILE$ FOR INPUT AS #1: INPUT #1, A,C
  17. 60  DIM D(A,C),CS(A,C+5),SR(3,C*2+1),N$(A),X(A),X2(A),T(A),SD(A),MD(A),C(C),CF(C)
  18. 70  FOR T=1 TO A: INPUT #1, T(T): NEXT
  19. 80  FOR T=1 TO A: FOR Z=1 TO C: INPUT #1, D(T,Z): NEXT: NEXT
  20. 90  FOR T=1 TO A: FOR Z=1 TO T(T): INPUT #1, CS(T,Z): NEXT: NEXT
  21. 100  FOR T=1 TO A: INPUT #1, N$(T),X(T),X2(T),MD(T),SD(T): NEXT: CLOSE #1
  22. 110  PRINT :PRINT :PRINT
  23. 120  PRINT TAB(15);"1.)  WILCOXON RANK SUM TEST (independent samples)": PRINT
  24. 125  PRINT TAB(15);"2.)  SIGNED RANK TEST   (paired samples)": PRINT
  25. 130  PRINT TAB(15);"3.)  RANK CORRELATION COEFFICIENT": PRINT :PRINT
  26. 140  PRINT TAB(20);:INPUT "Select the RANK test you want:     ",ASUB
  27. 142  IF ABS(ASUB-2)>1.01 THEN BEEP: GOTO 140
  28. 145  CLS: ON ASUB GOTO 200,620,950
  29. 150  PRINT: PRINT TAB(5);"What are the SAMPLE NUMBERS of the 2 groups you want to compare?": PRINT: PRINT TAB(10);
  30. 155  PRINT TAB(10);: INPUT;"Number:  ",NS1: IF NS1<=A THEN PRINT " `";N$(NS1);"'"; ELSE GOSUB 165: GOTO 155
  31. 160  PRINT TAB(46);: INPUT;"Number:  ",NS2: IF NS2<=A THEN PRINT " `";N$(NS2);"'": GOTO 170 ELSE GOSUB 165: GOTO 160
  32. 165  BEEP: PRINT TAB(20);FILE$;" has only";A;"samples.": RETURN
  33. 170  IF ASUB<3 THEN PRINT "Medians = ";TAB(17);MD(NS1);TAB(53);MD(NS2)
  34. 172  IF ASUB<2 OR T(NS1)=T(NS2) THEN 180 ELSE PRINT: PRINT "These 2 samples do not have the same number of elements----": PRINT TAB(25);"a rank correlation coefficient cannot be calculated."
  35. 173  PRINT: PRINT TAB(20);"Press any key to return to menu:"
  36. 175  A$=INKEY$: IF A$="" THEN 175 ELSE 110
  37. 180  PRINT: PRINT: RETURN
  38. 200  PRINT TAB(18);"WILCOXON RANK SUM TEST (two-tailed)": PRINT TAB(18);STRING$(35,205)
  39. 201  IF FILE$<>"" THEN GOSUB 150: N=T(NS1)+T(NS2): GOTO 210
  40. 202  PRINT :PRINT :PRINT TAB(10);
  41. 203  INPUT "Enter the NUMBER of observations in Sample #1:  ",N1
  42. 204  PRINT TAB(10);:INPUT "Enter the NUMBER of observations in Sample #2:  ",N2
  43. 205  PRINT: N=N1+N2: NMN=1: IF N1>N2 THEN NMN=2: N3=N2: N2=N1: N1=N3
  44. 206  PRINT TAB(12);"Enter the SUM of the ranks for Sample #";NMN;:INPUT ":  ",T
  45. 207  ERASE C,CF: DIM C(N1),CF(N1): GOTO 370
  46. 210  T1=1: T2=1
  47. 220  PRINT: AP=CSRLIN: COLOR 23: PRINT TAB(26);"RANKING SAMPLES": COLOR 7
  48. 230  FOR Z=1 TO N: V1=VAL(D(NS1,CS(NS1,T1))): V2=VAL(D(NS2,CS(NS2,T2)))
  49. 235  IF T1>T(NS1) THEN SR(1,Z)=V2: SR(2,Z)=0: T2=T2+1: GOTO 260
  50. 240  IF T2>T(NS2) THEN SR(1,Z)=V1: SR(2,Z)=1: T1=T1+1: GOTO 260
  51. 245  IF V1<V2 THEN SR(1,Z)=V1: SR(2,Z)=1: T1=T1+1: GOTO 260
  52. 250  SR(1,Z)=V2: SR(2,Z)=0: T2=T2+1
  53. 260  NEXT: AD=1: SZ=1
  54. 270  FOR Z=1 TO N
  55. 280  IF SR(1,Z)=SR(1,Z+1) THEN AD=AD+1: SZ=SZ+Z+1: GOTO 300
  56. 290  FOR T=Z TO (Z+1-AD) STEP -1: SR(3,T)=SZ/AD: NEXT T: SZ=Z+1: AD=1
  57. 300  NEXT Z: SR1=0: SR2=0
  58. 310  FOR Z=1 TO N
  59. 320  IF SR(2,Z)=1 THEN SR1=SR1+SR(3,Z) ELSE SR2=SR2+SR(3,Z)
  60. 330  NEXT
  61. 340  LOCATE AP,18: PRINT "Sum of ranks for SAMPLE ";NS1;" = ";SR1: PRINT
  62. 350  PRINT TAB(18);"Sum of ranks for SAMPLE ";NS2;" = ";SR2: PRINT
  63. 360  IF T(NS1)<=T(NS2) THEN N1=T(NS1): N2=T(NS2): T=SR1 ELSE N1=T(NS2): N2=T(NS1): T=SR2
  64. 370  XN=N1*(N+1): IF XN-T<T THEN T=XN-T
  65. 380  AK=0: IF N>30 AND T>XN-1.96*SQR(N1*N2*(N+1)/12) THEN AK=1: AP=CSRLIN: AP=AP+3: GOTO 600
  66. 390  T=T-N1*(N1+1)*0.5
  67. 400  PRINT:PRINT: AP=CSRLIN: COLOR 23: PRINT TAB(22);"CALCULATING PROBABILITY"
  68. 410  BF=4: WT=0: FT=0: CB=0: CBF=0
  69. 420  FOR Z=1 TO N1: C(Z)=0: CF(Z)=0: NEXT
  70. 430  IF N1<4 THEN 512
  71. 440  IF T-CBF<=N2-CB THEN CT=T-CBF+1: CK=0: GOTO 475
  72. 450  CX=N2-CB+1: CD=T-CBF-CX+1: CDD=CX-CD: CK=INT(CD*0.5+0.5)
  73. 452  IF CD<=CX THEN 458
  74. 453  CDD=0: CDK=CD: CD=CX: IF CK>CX THEN CK=CX
  75. 454  FOR Z=1 TO CK: WT=WT+CD*0.5*(CX+CDD+1)+INT((CDD*(CDD+2)+1)*0.25)
  76. 455  CX=CX-1: CDK=CDK-2: IF CDK>=CX THEN CD=CX ELSE CD=CDK
  77. 456  CDD=CX-CD
  78. 457  NEXT Z: GOTO 470
  79. 458  FOR Z=1 TO CK: WT=WT+CD*0.5*(CX+CDD+1)+INT((CDD*(CDD+2)+1)*0.25)
  80. 460  CX=CX-1: CD=CD-2: CDD=CDD+1
  81. 465  NEXT Z
  82. 470  CT=T+1-CBF-3*CK
  83. 475  FOR Z=1 TO INT(CT/3+0.7): WT=WT+INT((CT*(CT+2)+1)*0.25): CT=CT-3: NEXT Z
  84. 480  CBF=CBF+4
  85. 490  IF CBF>T THEN BF=BF+1: IF BF>N1 THEN 530 ELSE CF(BF)=CF(BF)+BF: CBF=CF(BF): GOTO 490
  86. 500  C(BF)=C(BF)+1
  87. 510  FOR Z=2 TO BF: C(Z)=C(BF): CF(Z)=CBF: NEXT Z: BF=4: CB=C(4): CBF=CF(4): GOTO 440
  88. 512  BF=N1-1: CT=T-CF(BF)+1: CX=N2-C(BF)+1
  89. 514  IF CT<=CX THEN WT=WT+CT ELSE WT=WT+CX
  90. 516  CF(BF)=CF(BF)+N1+1-BF
  91. 518  IF CF(BF)>T OR C(BF)>=N2 THEN BF=BF-1: IF BF<1 THEN 530 ELSE CF(BF)=CF(BF)+ N1+1-BF: GOTO 518
  92. 520  C(BF)=C(BF)+1
  93. 525  FOR Z=BF+1 TO 2: C(Z)=C(BF): CF(Z)=CF(BF): NEXT Z: GOTO 512
  94. 530  FT=N: FOR Z=N1 TO 2 STEP -1: N=N-1: FT=FT*N/Z: IF FT>1E+35 THEN 560
  95. 550  NEXT Z: P=WT*2/FT: GOTO 600
  96. 560  FT=LOG(FT): FOR Z=Z-1 TO 2 STEP -1: N=N-1: FT=FT+LOG(N/Z): NEXT Z
  97. 570  FOR Z=Z-1 TO 2 STEP -1: N=N-1: FT=FT+LOG(N/Z): NEXT Z
  98. 580  P=EXP(LOG(2*WT)-FT)
  99. 600  PLAY "MB ML T150 L32 N56N44N56N44N56N44N54N42N54N42N54N42N53N41N53N41N51N39N51N39N51N39N49N37N49N37N49N37N49N37N49N37N49N37 "
  100. 610  COLOR 0,7: LOCATE AP,1: PRINT TAB(26); "P = ";: IF AK=1 THEN PRINT "> .05"; ELSE IF P<1E-08 THEN PRINT  "< 10 (-8)"; ELSE PRINT P;
  101. 615  PRINT TAB(75): COLOR 7,0: GOTO 1050
  102. 620  PRINT TAB(22);"SIGNED RANK TEST (two-tailed)":PRINT TAB(22);STRING$(29,205)
  103. 621  IF FILE$<>"" THEN GOSUB 150: GOTO 640
  104. 622  PRINT: PRINT TAB(10);:INPUT "Enter the NUMBER of observations in each sample group:  ",N
  105. 623  ERASE C,CF: DIM C(N),CF(N)
  106. 624  PRINT: PRINT TAB(15);:INPUT "Enter the SUM of negative signed ranks:  ",NN
  107. 625  PRINT TAB(15);:INPUT "Enter the SUM of positive signed ranks:  ",NP
  108. 626  IF ABS(NN)<=NP THEN T=ABS(NN) ELSE T=NP
  109. 627  IF ABS(NN)+NP<>N*(N+1)*0.5 THEN BEEP: PRINT "The SUM of the absolute values of positive and negative ranks should = ";N*(N+1)*0.5
  110. 630  GOTO 800
  111. 640  PRINT: AP=CSRLIN: COLOR 23: PRINT TAB(26);"RANKING SAMPLES": COLOR 7
  112. 650  N=T(NS1): CR=0
  113. 660  FOR Z=1 TO N: V1=VAL(D(NS1,Z)): V2=VAL(D(NS2,Z)): VD=V1-V2
  114. 670  IF ABS(VD)<0 THEN 710
  115. 680  CR=CR+1: AY=CR
  116. 690  FOR TZ=1 TO CR-1:IF ABS(VD)<ABS(SR(1,TZ)) THEN SR(1,AY)=SR(1,AY-1):AY=AY-1
  117. 700  NEXT TZ: SR(1,AY)=VD
  118. 710  NEXT Z: AD=1: SZ=1
  119. 720  FOR Z=1 TO CR: IF ABS(SR(1,Z))=ABS(SR(1,Z+1)) THEN AD=AD+1: SZ=SZ+Z+1:  GOTO 750
  120. 730  FOR T=(Z+1-AD) TO Z: SR(2,T)=SZ/AD: IF SR(1,T)>0 THEN SR(3,T)=1
  121. 740  NEXT T: SZ=Z+1: AD=1
  122. 750  NEXT Z: SNP=0: SNN=0
  123. 760  FOR Z=1 TO CR: IF SR(3,Z)=1 THEN SNP=SNP+SR(2,Z) ELSE SNN=SNN+SR(2,Z)
  124. 770  NEXT Z
  125. 780  LOCATE AP,15: PRINT "The sum of positive signed RANKS is: ";SNP: PRINT
  126. 790  PRINT TAB(15);"The sum of negative signed RANKS is: ";SNN: PRINT
  127. 795  T=SNN: IF SNN>SNP THEN T=SNP
  128. 800  PRINT:PRINT:AP=CSRLIN: COLOR 23: PRINT TAB(24);"CALCULATING PROBABILITY"
  129. 805  IF N<5 THEN P=1: GOTO 942
  130. 810  WT=N+1: IF WT>T+1 THEN WT=T+1
  131. 815  IF T<=N THEN CT=T-2: GOTO 850
  132. 820  CX=N-1: CD=T-CX-2: CDD=CX-CD: CK=INT(CD*0.5+0.5)
  133. 825  CDK=CD: IF CD>CX THEN CDD=0: CD=CX: IF CK>CX THEN CK=CX
  134. 830  FOR Z=1 TO CK: WT=WT+CD*0.5*(CX+CDD+1)+INT((CDD*(CDD+2)+1)*0.25)
  135. 835  CX=CX-1: CDK=CDK-2: IF CDK<CX THEN CD=CDK ELSE CD=CX
  136. 840  CDD=CX-CD: NEXT Z
  137. 845  CT=T-3*CK-2
  138. 850  FOR Z=1 TO INT(CT/3+0.7): WT=WT+INT((CT*(CT+2)+1)*0.25): CT=CT-3: NEXT Z
  139. 855  AS=0: FOR Z=1 TO N: C(Z)=Z-1: CF(Z)=AS: AS=AS+Z: NEXT Z
  140. 860  C(4)=4: CB=4: CBF=10: BF=4
  141. 865  IF T-CBF<=N-CB THEN CT=T-CBF+1: GOTO 915
  142. 870  CX=N-CB+1: CD=T-CBF-CX+1: CDD=CX-CD: CK=INT(CD*0.5+0.5)
  143. 875  IF CD<=CX THEN 900
  144. 880  CDD=0: CDK=CD: CD=CX: IF CK>CX THEN CK=CX
  145. 885  FOR Z=1 TO CK: WT=WT+CD*0.5*(CX+CDD+1)+INT((CDD*(CDD+2)+1)*0.25)
  146. 890  CX=CX-1: CDK=CDK-2: IF CDK<CX THEN CD=CDK ELSE CD=CX
  147. 895  CDD=CX-CD: NEXT Z: GOTO 910
  148. 900  FOR Z=1 TO CK: WT=WT+CD*0.5*(CX+CDD+1)+INT((CDD*(CDD+2)+1)*0.25)
  149. 905  CX=CX-1: CD=CD-2: CDD=CDD+1: NEXT Z
  150. 910  CT=T+1-CBF-3*CK
  151. 915  FOR Z=1 TO INT(CT/3+0.7): WT=WT+INT((CT*(CT+2)+1)*0.25): CT=CT-3: NEXT Z
  152. 920  CBF=CBF+4
  153. 925  IF CBF>T THEN BF=BF+1: IF BF>N THEN 940 ELSE CF(BF)=CF(BF)+BF: CBF=CF(BF):   FOR Z=4 TO BF-1: C(Z)=C(BF)+1: CF(Z)=CBF: NEXT Z: GOTO 925
  154. 930  C(BF)=C(BF)+1
  155. 935  CB=C(BF): BF=4: GOTO 865
  156. 940  IF N<100 THEN P=WT/2^(N-1) ELSE P=EXP(LOG(WT)-(N-1)*LOG(2))
  157. 942  PLAY "MB O3 T100 L10 CL24D#L10EL32 GF# L10 G. L32 ED L16 E L30 GE L5 C"
  158. 945  LOCATE AP,1: COLOR 0,7: PRINT TAB(26);"P =  ";: IF P>0.5 THEN PRINT "> .5"; ELSE IF P<1E-08 THEN PRINT "< 10 (-8)"; ELSE PRINT P;
  159. 948  PRINT TAB(75);: COLOR 7,0: GOTO 1050
  160. 950  PRINT TAB(23);"SPEARMAN'S RANK CORRELATION ": PRINT TAB(23);STRING$(27,205)
  161. 955  GOSUB 150
  162. 960  N=T(NS1): CD=0: S2=0
  163. 965  FOR Z=1 TO N
  164. 970  FOR T=1 TO N: IF CS(NS1,Z)=CS(NS2,T) THEN CD=Z-T: S2=S2+CD*CD
  165. 975  NEXT T: NEXT Z
  166. 980  SR=1-(6*S2/(N*(N*N-1)))
  167. 990  PLAY "MB MS O3 L11 CCC O2 L2 C": PRINT : PRINT TAB(10);: COLOR 0,7
  168. 1000  PRINT TAB(15); "Correlation coefficient = ";SR;TAB(65): COLOR 7,0
  169. 1010  PRINT :PRINT :PRINT "The probability that a given value of Spearman's correlation coefficient is": PRINT "  significantly different that 0 can be evaluated by reference to tables."
  170. 1050  PRINT :PRINT :PRINT: PRINT TAB(7);
  171. 1060  PRINT "Do you want to perform another rank test ";
  172. 1070  IF FILE$="" THEN PRINT "? (Y or N)  ";ELSE PRINT "using this datafile?  ";
  173. 1080  INPUT "",A$
  174. 1090  IF A$="Y" OR A$="y" THEN CLS: GOTO 110
  175. 1100  END
  176. 1110  BEEP: PRINT: IF ERL=50 AND ERR=53 THEN PRINT: PRINT TAB(13); "I cannot find a file by that name on drive "; ELSE 1150
  177. 1120  IF MID$(FILE$,2,1)=":" THEN DR$=LEFT$(FILE$,2) ELSE DR$="A:"
  178. 1130  PRINT DR$: PRINT "Your files are:": FILES DR$+"*.*": RESUME 30
  179. 1150  ON ERROR GOTO 0
  180.